COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C******  SCMSS *********** 12/1/75
C00018 00003	2114	FORMAT(72A1)
C00023 ENDMK
C⊗;
C******  SCMSS *********** 12/1/75
	SUBROUTINE SCMSS
	COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(250),ITEM,LL,IS,IX
	COMMON/RINP/R(10,80),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
	1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
	DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C  /SCX/ ALSO IN WORDS, NEWR
	COMMON/SCX/RHY(4),JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
	1/STF/RSTFAC(8),RSTJ2/FRMT/F78F(1),FA1(1),FA5(1),IREAD
	1/XRN/RN(2000) /ALF/INP(72),ML 
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
	1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
	1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
	1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
	1JALPHA(3))
	DATA IXX/'X'/,LCNT/1/,RHY/.5,.25,.125,.0625/
	1,ISEMI/';'/,IBLA/' '/,KSLA/'/'/
	ISX=IS
C  SAVE RN COUNTER FOR ZERO FEATURE AT 168
1177	IF(JA.EQ.14)GO TO 77
	IF(JA.NE.144)GO TO 11
77	MODE=1
CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
	TYPE 444,SET4
	IBEAM=-1
	IZ=0
	IREAD=0
11	IF(IREAD)GO TO 2304
	IF(JA.NE.144)GO TO (1,2,3,4,5,69)MODE
2302	IF(IREAD)GO TO 2304
	REREAD 80052,L,L,L,STAFF,RMODE2
	GO TO 2177
2304	IF(IREAD.EQ.-1)REREAD 21141,L,INP
	IF(IREAD.EQ.-2)REREAD 2114,INP
2303	TYPE 80053
	IF(STFNUM(STAFF))GO TO 2305
	TYPE 80052,STAFF
	IF(RB)TYPE 444,SET4
C FILE CAN SET STAFF # AND SPACING STAFF # (STn/SPn/)
CC	IF(JA.EQ.144)GO TO 2177
	GO TO 4177
2305	ACCEPT 80052,STAFF
  	IF(STAFF.NE.444)GO TO 2177
	REREAD 4177,RA,RB
	IF(RA.NE.'SP')GO TO 4177
C NOW SPACER CAN BE SET AT THIS POINT
	SET4=RB
	GO TO 2303
4177	FORMAT(A2,F)
	TYPE 8009,MODE,INP
2177	IF(STAFF.GE.99)GO TO 690
C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
	REND=0
	IF(IREAD)GO TO 80041
	IF(LOOK(L)+LOOKD(L))GO TO 101 
	TYPE 101,L
	GO TO 690
101	FORMAT(' FILE NOT FOUND - ',A5)
	IREAD=-1
C FOR 1ST TIME IN BEAMS.
	REWIND 22
	CALL IFILE(22,L)
2301	IF(IREAD.EQ.-2)GO TO 2307
	READ(22,21141,END=68),L,INP
	IF(L.NE.0)GO TO 2300
C  JUMP IF LINE NUMBERS
	IF(INP1.EQ.'O')GO TO 2307
	IREAD=-2
C  THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
	REREAD 2114,INP
	GO TO 2300
2307	READ(22,2114,END=68)INP
	IF(IREAD.EQ.-2)GO TO 2300
	IF(INP3.NE.ISEMI)GO TO 2307
	IREAD=-2
	READ(22,2114)INP
	GO TO 2307
2300	IF(JA.NE.144)GO TO 2308
	IF(MODE.EQ.1)GO TO 2303
2308	IF(MODE.EQ.6)GO TO 1111
	IF(INP1.EQ.IBLA)GO TO 8006
	IF(INP1.EQ.ISEMI)GO TO 8006
C  'ET' FILES MUST HAVE ';' AS 1ST CHAR.  BLANK LINES ARE IGNORED!!
	TYPE 8009,MODE,INP
	GO TO 6177
1111	MODE=1
	REND=2
	IZ=0
CC	RETURN
C   ABOVE ALLOWS MORE STAVES TO BE READ
168	IF(NOSET.EQ.0)RETURN
	L=ISX
2168	RA=RN(L+1)
	IF(RA.EQ.1)GO TO 3168
	IF(RA.NE.2)GO TO 1168
	N=7
	GO TO 4168
3168	IF(RN(L).LT.7)GO TO 1168
C  SKIP NOTES SANS RHYTH. (CHORD NOTES.)
	N=9
4168	RN(L+N)=0
C  ZEROS RHYTHM OF ADDED INPUT ON SPACING STAFF
1168	L=L+RN(L)+3
	IF(L.LT.IS)GO TO 2168
	RETURN

80053	FORMAT(' NEXT STAFF NUM='$)
80052	FORMAT(F,A4,A5,2F)
444	FORMAT(' SPACING STAFF =',F3.0)

4	TYPE 8002
CC330	ACCEPT 2114,N,L,INP3,INP4
330	ACCEPT 2114,INP
	IF(INP1.EQ.'G')GO TO 69
C  TYPE 'GO' TO PASS LATER ITEMS
	IF(INP1.EQ.'9')GO TO 99
	IF(INP1.EQ.'B')GO TO 99
	IF(INP1.EQ.'Y')GO TO 1
	DO 2001 K=2,6
2001	IF(INP(K).EQ.'B')GO TO 134
C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
	IF(INP1.EQ.'N')GO TO 2000
	IF(INP1.NE.IBLA)GO TO 11
C  PICKS UP TYPOS
2000	MODE=MODE+1
	WRITE(21,2114)INP4
	GO TO 11
691	FORMAT(' INPUT SAVED ON FOR21.DAT')
69	END FILE 21
	TYPE 691
690	REND=1
CC	RETURN
	GO TO 168
3	TYPE 8023
	GO TO 330
5	TYPE 8022
	GO TO 330

8006	MODE=MODE+1
	IF(MODE.NE.2)GO TO 177
	IF(RMODE2.EQ.2)GO TO 80041
C   FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
177	IF(IREAD)GO TO 2301
	IF(MODE.LE.5)RETURN
	END FILE 21
	TYPE 691
68	REND=-1
CC	RETURN
	GO TO 168

99	IF(INP3.EQ.'9')GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
	MODE=MODE-1
	IF(MODE.EQ.0)GO TO 999
	IS=ISV(MODE)
	GO TO 11
C  INSERT BACKUP ROUTINE
999	REND=99
	RETURN
C FIX BACKUPS********

8008	FORMAT(' TYPE ',I2,' RHYTHMS')
8002	FORMAT(' ADD BEAMS?  '$)
8022	FORMAT(' ADD SLURS?  '$)
8023	FORMAT(' ADD MARKS?  '$)
8009	FORMAT(I2,4X,72A1)
8011	FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
8015	K=IRHY-I+1
	TYPE 8011,K
	IF(IREAD)IREAD=-IREAD
C  ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
2	TYPE 8008,IRHY

1	ISV(MODE)=IS
	CALL TYPE
	REREAD 4177,RA,RB
	IF(RA.NE.'SP')GO TO 5177
	SET4=RB
C CAN SET SPACER HERE
	GO TO 1177
5177	IF(INP1.EQ.IBLA) GO TO 1
	IF(INP1.NE.'9')GO TO 80041
	IF(INP2.EQ.'9')GO TO 99
C  TYPE '99' TO BACK-UP
80041	WRITE(21,2114)INP
6177	CALL LNEND
	IF(MODE.GE.3)GO TO 133
	RETRO=-1.
	I=1
	PARENS=0
	MOT=0
      JZ=1  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      KL=0  
      RA=0  
	IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
	IF(INP(1).NE.'S')GO TO 2408
	IF(INP(2).NE.'T')GO TO 2408
	K=1
	L=3
	IF(INP3.NE.'-')GO TO 1277
	K=-1
	L=4
1277	STAFF=NALF(INP(L))*K
2277	MLX=L+1
	IF(INP(MLX).NE.KSLA)GO TO 2277
	MLX=MLX+1
	GO TO 3277
2408	MLX=1
3277	L=-1
	IF(RMODE2.EQ.2)CALL PRESCN
C   GO SORT OUT THE NEW FORMAT
	DO 2999 K=1,72
	N=INP(K)
	IF(N.EQ.IBLA)GO TO 2999
	L=0 
	IF(N.EQ.ISTAR)GO TO 277
	IF(N.NE.ISEMI)GO TO 2999
C  READS 72 CHARS. INCLUDING *.
277	INP(K+1)=ISEMI
	GO TO 1773
C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999	CONTINUE
	IF(IREAD)GO TO 8015
	TYPE 6999
	GO TO 1
6999	FORMAT(' ****** TRY AGAIN ***** ')
CC	GO TO 69
C   ERROR IF NO '*' OR ';' AT END OF LINE.

1299	IF(JZ.NE.0)GO TO 1773
7773	IF(MODE.NE.2)GO TO 377
	IF(RMODE2.EQ.2)GO TO 77732
C  ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
377	IF(IREAD.EQ.0)GO TO 77731
C   BYPASS IF NOT USING EDIT FILE
	IF(IREAD.EQ.-1)READ(22,21141),L,INP
	IF(IREAD.EQ.-2)READ(22,2114)INP
C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
	TYPE 8009,MODE,INP
	GO TO 77732
77731	CALL TYPE

	IF(INP1.EQ.IBLA)GO TO 7773
	WRITE(21,2114)INP
77732	CALL LNEND
	JM=-1
	JZ=0
	GO TO 2408
C   'LISTS' MUST END WITH * 
1773	JZ=0
	DBST=1.
	IF(XDBST)DBST=-DBST
	XDBST=0
17731	ML=MLX
	IF(PARENS.LE.0.)GO TO 975
C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362	PARENS=0
	MOT=I-LMOT
	IF(LCNT+MOT.LT.198)GO TO 33621
	DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
	TYPE NOMOR,JMOT
	GO TO 1
33621	JLIST(LCNT+1)=MOT
	LCNT=LCNT+2
	DO 2140 JG=0,MOT-1
2140	RLIST(LCNT+JG)=V(LMOT+JG)
	LCNT=LCNT+MOT
	IF(IAMP)GO TO 3013
C  FOR CLOSE PARENS ON LAST ITEM
C   STORE MOTIVE IN RLIST ARRAY

975	DO 236 JDD=ML,72
	JD=JDD
	N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
	IF(N.EQ.ILP)GO TO 477
	IF(N.EQ.IRP)GO TO 477
	IF(N.NE.ICOL)GO TO 2361
477	INP(JD)=IBLA
	IF(N.NE.ICOL)GO TO 1113
	XDBST=-1.
	GO TO 5362
C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113	L=JD-1
5113	IF(INP(L).NE.IBLA)GO TO 2113
	L=L-1
	GO TO 5113
2113	IF(N.EQ.IRP)GO TO 3361
C  ONLY ONE () AS YET,  NO NESTING
1140	JMOT=INP(L)
C   MOTIVE NAME
	DO 11401 JC=1,LCNT-1
	IF(JMOT.NE.JLIST(JC))GO TO 11401
C  FINDS DUPLICATE IDENTIFIER
11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
	TYPE 11402,JMOT
	JLIST(JC)=0
C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401	CONTINUE
	JLIST(LCNT)=JMOT
	PARENS=-1.
C   A PARENTH IS OPEN
	INP(L)=IBLA
	LMOT=I
C   LMOT IS CURRENT POINT IN V ARRAY
	GO TO 236
3361	IF(PARENS.NE.0)GO TO 33612
	DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
	TYPE WARN
33611	INP(JD)=IBLA
	GO TO 236
33612	PARENS=1.
C   SETS PARENS CLOSED FLAG
	GO TO 33611
C   NO INVERSIONS POSSIBLE NOW
2361	IF(N.NE.IAT)GO TO 5361
	DO 113 L=1,72
	K=JD+L
C   K IS USED AT 240!!!
	JG=INP(K)
	IF(JG.NE.NEG)GO TO 7113
	RETRO=0
	INP(K)=IBLA
	GO TO 113
7113	IF(JG.NE.IBLA)GO TO 4113
113	CONTINUE
4113	DO 6361 L=1,LCNT
	IF(JG.NE.JLIST(L))GO TO 6361
	VX1=0
	DO 40 M=JD+2,72
	JG=INP(M)
	IF(JG.EQ.IBLA)GO TO 40
	IF(JG.EQ.KSLA)GO TO 140
	IF(JG.EQ.ISEMI)GO TO 140
	IF(JG.EQ.ISTAR)GO TO 140
	ML=M
	GO TO 240
40	CONTINUE
240	JC=JM
	JM=-1
	INP(K)=IBLA
	JN=0
C   MUST BE ZERO IN SCANR
	CALL SCANR
	JM=JC
140	JC=1
	KN=L+2
	M=KN+JLIST(L+1)
	IF(RETRO)GO TO 940
	KN=M-1
	M=L+1
	JC=-1
	RETRO=-1.

940	Z=RLIST(KN)
	IF(VX1.EQ.0)GO TO 540
C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
	IF(MODE.EQ.1)GO TO 440
C  MODE 1 IS NOTES, 2 IS RHY.
	V(I)=Z*VX1
	GO TO 7361
440	IF(ABS(Z).GE.2000.)GO TO 540
C  SKIPS NON-NOTES
	RB=VX1
	IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C  NEG NUMS ARE CHORD NOTES.
	V(I)=Z+RB
	GO TO 7361
540	V(I)=Z
7361	I=I+1
	KN=KN+JC
	IF(KN.NE.M)GO TO 940

	RB=V(I-1)
	DO 8361 L=JD,72
	JG=INP(L)
	INP(L)=IBLA
	IF(JG.EQ.KSLA)GO TO 9361
	IF(JG.EQ.ISEMI)GO TO 93611
8361	IF(JG.EQ.ISTAR)IAMP=-1
9361	MLX=L
	IF(IAMP.EQ.0)GO TO 17731
	JZ=-1
93611	IF(IAMP)GO TO 3013
	GO TO 7773
6361	CONTINUE
	TYPE 6362,JG
	GO TO 11402
6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361	IF(N.NE.KSLA)GO TO 636
5362	MLX=JD+1
	JZ=-1
	INP(JD)=ISEMI
436	IF(INP(MLX).NE.IBLA)GO TO 103
	MLX=MLX+1
	GO TO 436
636	IF(N.EQ.ISEMI)GO TO 103
936	IF(N.NE.IDOT)GO TO 736
	L=INP(JD+1)
	KL=NALF(L)
	IF(L.LE.0)GO TO 577
	IF(KL.LT.0)GO TO 577
	IF(KL.LE.9)GO TO 236
C   JUMP IF IT'S A NUMBER
577	IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
	GO TO 236
C   CHANGES DOTTED RHYTHMS TO '1'S.
736	IF(N.NE.ISTAR)GO TO 236
	IAMP=-1
	INP(JD)=ISEMI
	GO TO 103
236	CONTINUE
2114	FORMAT(72A1)
21141	FORMAT(I,72A1)

5016	IF(IAMP.GE.0)GO TO 1299
	IF(PARENS.NE.0)GO TO 3362
C  PARENS ARE STILL OPEN?
	GO TO 3013
103	K=INP(ML)

C   LAST SECTION
	IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
	IF(K.NE.IBLA) GO TO 1899
	ML=ML+1
	GO TO 103
1899	JN=0
C   MUST BE ZERO IN SCANR
	VX4=0
	NOAC=0
	CALL SCANR
      IF(VX1.EQ.-99.)GO TO 4022
	IF(MODE.NE.2)GO TO 17
C*********** MODE #?
2017	IF(VX1.EQ.10000.)GO TO 17
      VX1=4./VX1
	IF(JJ.NE.1)GO TO 2014
	V(I)=VX1
	GO TO 114
2014	DO 9006 L=2,JJ
	IF(VX(L).EQ.0)GO TO 17
9006	VX1=4./VX(L)+VX1
	JJ=1
17	V(I)=VX1
	IF(VX4.EQ.0)GO TO 115
	IF(MODE.NE.1)GO TO 115
	I=I+1
C  FOR + OR -.  AUTO OCTAVES, ETC.
	V(I)=-VX1-VX4
115	IF(JJ.LE.1)GO TO 114
	IF(MODE.NE.1)GO TO 171
	IF(VX2.EQ.0)GO TO 171
C  JUMP IF RHY OR 'X 4' ETC.
	V(I)=18000.0+VX1*10.0+VX2/10.0
C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
114	I=I+1
	GO TO 5016
171	JC=1
	JD=VX(JJ)-1
	I=I+1
	GO TO 5005
1014	JD=1
	JC=1
C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
	GO TO 5005
4022      JC=VX2+.3
      JD=VX3-.5
	IF(JJ.EQ.2)JD=1
C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
5005	N=0
	DO 3005 K=I-1,1,-1
	IF(V(K))GO TO 3005
	IF(V(K).LT.3000)N=N+1
C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005	IF(N.EQ.JC)GO TO 4005
4005	IF(JC.GT.1)GO TO 7005
	IF(MODE.EQ.1)NOAC=-1
C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
7005	JC=I-K
C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
	DO 1005 K=1,JD    
       NL=I+JC-1  
      DO 2005 L=I,NL    
	KN=L-JC
	RB=V(KN)
	IF(NOAC.GE.0)GO TO 2005
	IF(ABS(RB).GE.2000)GO TO 2005
C  SKIP OVER IF NOT A NOTE
	RB=AMOD(RB,100.0)+1000.0
	IF(V(KN))RB=RB-2000.0
C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005	V(L)=RB
1005      I=I+JC  
      GO TO 5016  

3013	IF(MODE.NE.2)GO TO 771
	IF(I-1.NE.IRHY)GO TO 8015
C  WRONG NUMBER OF ITEMS
771	V(I)=-99.
	IF(MODE.NE.1)GO TO 132
C  FOR ADDED NOTES ON SPACING STAFF
	CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67	CALL NEWR
	GO TO 8006
132	IF(IREAD.GT.0)IREAD=-IREAD
	CALL RHYTH
C  =50 IS RHYTHM FOR TEXT
	GO TO 67
134	WRITE(21,2114)INP
C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C   ACCENTS ARE IN BEAMS SUBROUTINE
133	CALL BEAMS
	IF(MODE.EQ.3)GO TO 135
	IF(MODE.EQ.4)IBEAM=0
C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
	GO TO 8006
135	K=IS
	CALL NEWR
	IS=K
C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
	GO TO 8006
	END